home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / comm2 / rtdl10.lha / RtDnload / rtdnload.bas < prev   
BASIC Source File  |  1995-09-26  |  5KB  |  232 lines
  1. 'RtDnload by Peter Zelezny.
  2.  
  3. '1-sep-95
  4.  
  5. REM $OPTION Y
  6.  
  7. LIBRARY "exec.library"
  8. LIBRARY "reqtools.library"
  9.  
  10. DECLARE FUNCTION AllocMem& LIBRARY
  11. DECLARE FUNCTION FreeMem& LIBRARY
  12. DECLARE FUNCTION FindTask& LIBRARY
  13. DECLARE FUNCTION AllocSignal& LIBRARY
  14. DECLARE FUNCTION AddPort& LIBRARY
  15. DECLARE FUNCTION Forbid& LIBRARY
  16. DECLARE FUNCTION Permit& LIBRARY
  17. DECLARE FUNCTION FindPort& LIBRARY
  18. DECLARE FUNCTION PutMsg& LIBRARY
  19. DECLARE FUNCTION WaitPort& LIBRARY
  20. DECLARE FUNCTION GetMsg& LIBRARY
  21. DECLARE FUNCTION RemPort& LIBRARY
  22. DECLARE FUNCTION FreeSignal& LIBRARY
  23. DECLARE FUNCTION OpenLibrary& LIBRARY
  24. DECLARE SUB CloseLibrary& LIBRARY
  25.  
  26. DECLARE FUNCTION rtAllocRequestA& LIBRARY
  27. DECLARE FUNCTION rtFileRequestA& LIBRARY
  28. DECLARE FUNCTION rtChangeReqAttrA& LIBRARY
  29. DECLARE SUB rtFreeRequest& LIBRARY
  30.  
  31. ON ERROR GOTO error.handler
  32.  
  33. DIM SHARED PortAddress&, TaskAddr&, Dummy%, MsgPortName$, MsgPortName2$
  34. DIM SHARED Sig%, ControlPort&, ErrCode%, Arg1&, Arg2&, Reply&
  35. DIM SHARED i&, j%, Flag%, esc$, a%, L&, NameMemAddr&
  36.  
  37. e$=CHR$(27)+"["
  38. clear$=e$+"0m"+e$+"2J"+e$+"1H"
  39. cr$=CHR$(13)
  40. q$=CHR$(34)
  41. prob$="Unknown Error!"
  42.  
  43. IF COMMAND$="" THEN ? "Door control port not located": end
  44.  
  45. port$=COMMAND$
  46. MsgPortName$="DoorControl"+COMMAND$+CHR$(0)
  47. MsgPortName2$="DoorReply"+COMMAND$+CHR$(0)
  48.  
  49. CALL GetPort
  50.  
  51. IF ControlPort&=0 THEN end
  52. IF ErrCode% <> 0 THEN GOTO Exitt
  53.  
  54. '######################################################################
  55. 'Your Programme goes in here!!!!!
  56. '######################################################################
  57.  
  58.  PS clear$+cr$+cr$+"SysOp is selecting a file to send..."+cr$+cr$
  59.  GOSUB FINDSCREEN
  60.  
  61.  startdir$ = CURDIR$
  62.   
  63.  fr&=rtAllocRequestA&(0&,VARPTR(frtags&(0)))
  64.  TAGLIST VARPTR(frtags&(0)),50&,startdir$,0
  65.  x=rtChangeReqAttrA&(fr&,VARPTR(frtags&(0)))
  66.  title&=SADD("Choose file to send..."+CHR$(0))
  67.  filename&=SADD(STRING$(129,0))
  68.  TAGLIST VARPTR(t&(0)), 7&, maxscr&, 41&, 800&, 42&, "Send",0
  69.  
  70.  IF fr& THEN
  71.     IF rtFileRequestA&(fr&,filename&,title&,VARPTR(t&(0))) THEN
  72.         fil$ = PEEK$(filename&)
  73.         dir$ = PEEK$(PEEKL(fr&+16&))
  74.     ELSE
  75.         PS "Requestor failed."+cr$+cr$+"%Z"
  76.         GOTO exitt
  77.     END IF
  78.     rtFreeRequest fr&
  79.  ELSE
  80.      PS "Can't allocate memory."+cr$+cr$+"%Z"
  81.     GOTO exitt
  82.  END IF
  83.  
  84.  IF UCASE$(dir$)="RAM DISK:" THEN dir$="Ram:"
  85.  IF RIGHT$(dir$,1)<>":" AND RIGHT$(dir$,1)<>"/" THEN dir$=dir$+"/"
  86.  fildir$=dir$+fil$
  87.  
  88.  IF FEXISTS(fildir$) THEN
  89.      OPEN "I",#1,fildir$
  90.      size$=STR$(LOF(1))
  91.      CLOSE 1
  92.      PS clear$+cr$+cr$
  93.      PS e$+"1;35mFile: "+e$+"36m"+fil$+"   "
  94.      PS e$+"35mSize:"+e$+"36m"+size$+e$+"0m"+cr$+cr$
  95.      PS "Press [ESC] to abort -  Any other key to start."
  96.      hotkey k$
  97.      IF k$=CHR$(27) THEN exitt
  98.      dfunc 124,100,fildir$
  99.  ELSE
  100.      PS cr$+cr$+"File not found."+cr$+cr$+"%Z"
  101.  END IF
  102.  GOTO exitt
  103.  
  104. FINDSCREEN:
  105.  IntBase& = OpenLibrary&(SADD("intuition.library"),34&)
  106.  scr& = PEEKL(IntBase&+60%)
  107.  p$=port$
  108.  IF p$="0" THEN p$="1"
  109.  DO
  110.     nextscreen&    = PEEKL(scr&)
  111.     title&        = PEEKL(scr&+22%)
  112.     stitle$        = PEEK$(title&)
  113.     IF LEFT$(stitle$,16)=p$+": M A X's BBS V" THEN
  114.         maxscr&=scr&
  115.         EXIT LOOP
  116.     END IF
  117.     scr&=nextscreen&
  118.     IF scr&=0 THEN EXIT LOOP
  119.  LOOP
  120.  CloseLibrary& IntBase&
  121.  RETURN
  122.  
  123. '######################################################################
  124. 'And ends here
  125. '######################################################################
  126.  
  127. Exitt:
  128. CALL FreePort
  129. LIBRARY CLOSE
  130. SYSTEM
  131.  
  132. Error.Handler:
  133. PS cr$+e$+"31mError at line: "+STR$(ERL)+cr$+cr$
  134. PS "Please notify %a!!"+cr$+cr$+"%Z"
  135. GOTO exitt
  136.  
  137. SUB getport STATIC
  138. PortAddress&=AllocMem&(140&,&H10001)
  139. IF PortAddress&=0 THEN
  140.   PRINT "Couldn't allocate the memory!"
  141.   ErrCode%=2
  142.   GOTO Out
  143. END IF  
  144. TaskAddr&=FindTask&(0)
  145. POKEL PortAddress&+16,TaskAddr&
  146. Sig% = AllocSignal&(-1)
  147. IF Sig%<0 THEN
  148.   ErrCode%=3
  149.   GOTO Out
  150. END IF
  151. POKE PortAddress&+8,4
  152. POKEL PortAddress&+10,SADD(MsgPortName2$)
  153. POKE PortAddress&+15,Sig%
  154. POKE PortAddress&+42,5
  155. POKEW PortAddress&+52,106
  156. POKEL PortAddress&+48,PortAddress&
  157. Reply&=AddPort&(PortAddress&)
  158. Dummy%=Forbid&
  159. ControlPort&=FindPort&(SADD(MsgPortName$))
  160. Dummy%=Permit&
  161. Out:
  162. END SUB
  163.  
  164. SUB FreePort STATIC
  165. On ErrCode% goto Sig1,Sig2,Sig3,Sig4
  166. CALL GetMsgPrt (Arg1&,Arg2&)
  167. POKEW Arg2&,20
  168. Reply&=PutMsg&(ControlPort&,Arg1&)
  169. Pause:
  170. Reply&=WaitPort&(PortAddress&)
  171. Reply&=GetMsg&(PortAddress&)
  172. IF Reply&=0 THEN GOTO Pause
  173. Sig4:
  174. Dummy%=RemPort&(PortAddress&)
  175. Dummy%=PEEK(PortAddress&+15)
  176. Dummy%=FreeSignal&(Dummy%)
  177. Sig3:
  178. Dummy%=FreeMem(PortAddress&,140&)
  179. Sig2:
  180. Sig1:
  181. END SUB
  182.  
  183. SUB GetMsgPrt(Arg1&, Arg2&) STATIC
  184. Arg1&=PortAddress&+34
  185. Arg2&=PortAddress&+54
  186. POKEL Arg2&+2,0
  187. END SUB
  188.  
  189. SUB PS(St$) STATIC
  190. CALL GetMsgPrt (Arg1&, Arg2&)
  191. POKEW Arg2&,1       'command number
  192. POKEW Arg2&+2,0     'terminating null
  193. FOR i&=1 TO LEN(St$)
  194.   POKE Arg2&+3+i&,ASC(MID$(St$,i&,1))   'put the string in
  195. NEXT
  196. POKE Arg2&+3+i&,0
  197. CALL PutWaitMsg
  198. END SUB
  199.  
  200. SUB PutWaitMsg STATIC
  201. LOCAL Temp&, Locn&, Tempp&
  202. Reply&=PutMsg&(ControlPort&,Arg1&)
  203. Pause1:
  204. Reply&=WaitPort&(PortAddress&)
  205. Reply&=GetMsg&(PortAddress&)
  206. IF Reply&=0 THEN GOTO Pause1
  207. Tempp&=PEEKW(Reply&+24&+80&)
  208. IF Tempp&<>0 THEN GOTO Exitt                'lost carrier
  209. END SUB
  210.  
  211. SUB DFunc (f%,e%,file$) STATIC
  212. CALL GetMsgPrt(Arg1&,Arg2&)
  213. POKEW Arg2&,f%
  214. POKEW Arg2&+2,e%
  215. if file$<>""
  216.   FOR i&=1 TO LEN(file$)
  217.     POKE Arg2&+3+i&,ASC(MID$(file$,i&,1))
  218.   NEXT
  219.   POKE Arg2&+3+i&,0
  220. end if
  221. CALL PutWaitMsg
  222. END SUB
  223.  
  224. SUB hotkey (K$) STATIC
  225. CALL GetMsgPrt (Arg1&, Arg2&)
  226. POKEW Arg2&,8       'command number
  227. POKEW Arg2&+2,0     'terminating null
  228. POKE Arg2&+3+i&,0
  229. CALL PutWaitMsg
  230. K$=CHR$(PEEK(Arg2&+4))
  231. END SUB
  232.